home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tk / button.tcl < prev    next >
Text File  |  1997-11-22  |  5KB  |  186 lines
  1. # button.tcl --
  2. #
  3. # This file defines the default bindings for Tk label, button,
  4. # checkbutton, and radiobutton widgets and provides procedures
  5. # that help in implementing those bindings.
  6. #
  7. # SCCS: @(#) button.tcl 1.19 96/02/20 13:01:32
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #-------------------------------------------------------------------------
  17. # The code below creates the default class bindings for buttons.
  18. #-------------------------------------------------------------------------
  19.  
  20. bind Button <FocusIn> {}
  21. bind Button <Enter> {
  22.     tkButtonEnter %W
  23. }
  24. bind Button <Leave> {
  25.     tkButtonLeave %W
  26. }
  27. bind Button <1> {
  28.     tkButtonDown %W
  29. }
  30. bind Button <ButtonRelease-1> {
  31.     tkButtonUp %W
  32. }
  33. bind Button <space> {
  34.     tkButtonInvoke %W
  35. }
  36.  
  37. bind Checkbutton <FocusIn> {}
  38. bind Checkbutton <Enter> {
  39.     tkButtonEnter %W
  40. }
  41. bind Checkbutton <Leave> {
  42.     tkButtonLeave %W
  43. }
  44. bind Checkbutton <1> {
  45.     tkCheckRadioInvoke %W
  46. }
  47. bind Checkbutton <space> {
  48.     tkCheckRadioInvoke %W
  49. }
  50. bind Checkbutton <Return> {
  51.     if !$tk_strictMotif {
  52.     tkCheckRadioInvoke %W
  53.     }
  54. }
  55.  
  56. bind Radiobutton <FocusIn> {}
  57. bind Radiobutton <Enter> {
  58.     tkButtonEnter %W
  59. }
  60. bind Radiobutton <Leave> {
  61.     tkButtonLeave %W
  62. }
  63. bind Radiobutton <1> {
  64.     tkCheckRadioInvoke %W
  65. }
  66. bind Radiobutton <space> {
  67.     tkCheckRadioInvoke %W
  68. }
  69. bind Radiobutton <Return> {
  70.     if !$tk_strictMotif {
  71.     tkCheckRadioInvoke %W
  72.     }
  73. }
  74.  
  75. # tkButtonEnter --
  76. # The procedure below is invoked when the mouse pointer enters a
  77. # button widget.  It records the button we're in and changes the
  78. # state of the button to active unless the button is disabled.
  79. #
  80. # Arguments:
  81. # w -        The name of the widget.
  82.  
  83. proc tkButtonEnter {w} {
  84.     global tkPriv
  85.     if {[$w cget -state] != "disabled"} {
  86.     $w config -state active
  87.     if {$tkPriv(buttonWindow) == $w} {
  88.         $w configure -state active -relief sunken
  89.     }
  90.     }
  91.     set tkPriv(window) $w
  92. }
  93.  
  94. # tkButtonLeave --
  95. # The procedure below is invoked when the mouse pointer leaves a
  96. # button widget.  It changes the state of the button back to
  97. # inactive.  If we're leaving the button window with a mouse button
  98. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  99. # button too.
  100. #
  101. # Arguments:
  102. # w -        The name of the widget.
  103.  
  104. proc tkButtonLeave w {
  105.     global tkPriv
  106.     if {[$w cget -state] != "disabled"} {
  107.     $w config -state normal
  108.     }
  109.     if {$w == $tkPriv(buttonWindow)} {
  110.     $w configure -relief $tkPriv(relief)
  111.     }
  112.     set tkPriv(window) ""
  113. }
  114.  
  115. # tkButtonDown --
  116. # The procedure below is invoked when the mouse button is pressed in
  117. # a button widget.  It records the fact that the mouse is in the button,
  118. # saves the button's relief so it can be restored later, and changes
  119. # the relief to sunken.
  120. #
  121. # Arguments:
  122. # w -        The name of the widget.
  123.  
  124. proc tkButtonDown w {
  125.     global tkPriv
  126.     set tkPriv(relief) [lindex [$w config -relief] 4]
  127.     if {[$w cget -state] != "disabled"} {
  128.     set tkPriv(buttonWindow) $w
  129.     $w config -relief sunken
  130.     }
  131. }
  132.  
  133. # tkButtonUp --
  134. # The procedure below is invoked when the mouse button is released
  135. # in a button widget.  It restores the button's relief and invokes
  136. # the command as long as the mouse hasn't left the button.
  137. #
  138. # Arguments:
  139. # w -        The name of the widget.
  140.  
  141. proc tkButtonUp w {
  142.     global tkPriv
  143.     if {$w == $tkPriv(buttonWindow)} {
  144.     set tkPriv(buttonWindow) ""
  145.     $w config -relief $tkPriv(relief)
  146.     if {($w == $tkPriv(window))
  147.         && ([$w cget -state] != "disabled")} {
  148.         uplevel #0 [list $w invoke]
  149.     }
  150.     }
  151. }
  152.  
  153. # tkButtonInvoke --
  154. # The procedure below is called when a button is invoked through
  155. # the keyboard.  It simulate a press of the button via the mouse.
  156. #
  157. # Arguments:
  158. # w -        The name of the widget.
  159.  
  160. proc tkButtonInvoke w {
  161.     if {[$w cget -state] != "disabled"} {
  162.     set oldRelief [$w cget -relief]
  163.     set oldState [$w cget -state]
  164.     $w configure -state active -relief sunken
  165.     update idletasks
  166.     after 100
  167.     $w configure -state $oldState -relief $oldRelief
  168.     uplevel #0 [list $w invoke]
  169.     }
  170. }
  171.  
  172. # tkCheckRadioInvoke --
  173. # The procedure below is invoked when the mouse button is pressed in
  174. # a checkbutton or radiobutton widget, or when the widget is invoked
  175. # through the keyboard.  It invokes the widget if it
  176. # isn't disabled.
  177. #
  178. # Arguments:
  179. # w -        The name of the widget.
  180.  
  181. proc tkCheckRadioInvoke w {
  182.     if {[$w cget -state] != "disabled"} {
  183.     uplevel #0 [list $w invoke]
  184.     }
  185. }
  186.